Shareware Grab Bag/Shareware Grab Bag.iso/007/clock1.bas

BASIC Source File | 1985-09-29 | 13KB | 273 lines

100 REM This program was written by :
110 REM
120 REM
130 REM                               DAVID JOHNSON
140 REM                               551 Willlow st
150 REM                               S. Hempstead, N.Y. 11550
160 REM                               [phone]
170 REM
180 REM
190 REM IF YOU MODIFY THIS PROGRAM, PLEASE DO NOT DISTRIBUTE IT IN MODIFIED
200 REM FORM!             SUPPORT THE FREEWARE CONCEPT!
210 REM
220 REM
230 REM setting att to true assumes an AT&T PC6300 computer with 640x400
240 REM resolution. If an error occurs when opening mode 100 then resume
250 REM and set att to false (0), also turn off all the keys to clear the
260 REM screen of all the clutter.
270 ATT=-1
280 KEY 1,CHR$(26):KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":REM turn off all
290 KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""     :REM of the keys
300 ON ERROR GOTO 330:IF ATT THEN DISPV=400:DISPH=640:RAT=6/5:CLS
310 GOTO 340
320 REM Error opening mode 100, it must be an IBM type computer (640x200)
330 ATT=0:RESUME 340
340 IF NOT ATT THEN DISPV=200:DISPH=640:RAT=12/5:CLS
350 DIM HOUR$(12):OLDX$="00:00:00":X$="00:00:00":NEWTIME$="12:00:00":OLDALM$="12:00:00"
360 REM read in the hour and half hour chime sound
370 READ CHIME$
380 REM make hour contain the sound string for each hour
390 FOR X=1 TO 12:HOUR$(X)=CHIME$+STRING$(X,67):NEXT
400 REM go into graphics mode 100 (640x400) if it exists otherwise
410 REM enter mode 2 (640x200)
420 IF DISPV=400 THEN SCREEN 100,0 ELSE SCREEN 2,0
430 REM set up default settings incase disk file does not exist
440 CLS:KEY OFF:PI=3.1415:BELL=-1:ALARM$="12:00":TICK=-1:MODE=-1:TMP=-1:GOSUB 2430:LOCATE 1,20:PRINT"hit S to enter setup screen or <esc> to exit"
450 REM
460 REM MAIN CLOCK SCREEN
470 REM
480 GOSUB 610:LOCATE 1,20:PRINT "                                            "
490 X$=TIME$:I$=INKEY$:IF I$=CHR$(27) THEN GOSUB 2580:CLS:GOTO 420
500 IF I$="B" OR I$="b" THEN BELL=0-ABS(BELL+1)
510 LOCATE 25,1:IF BELL THEN PRINT"BELL ON "; ELSE PRINT"BELL OFF";
520 IF I$="A" OR I$="a" THEN ALARM=0-ABS(ALARM+1)
530 LOCATE 25,72:IF NOT ALARM THEN PRINT"ALARM OFF";:LOCATE 24,73:PRINT"      ";
540 IF I$="s" OR I$="S" THEN GOSUB 1710:CLS:GOTO 480
550 LOCATE 25,72:IF ALARM THEN PRINT"ALARM ON "; ELSE PRINT"ALARM OFF";
560 IF OLDX$<>X$ THEN OLDTIME$=X$:TMP=-1:GOSUB 720:OLDX$=OLDTIME$:GOTO 490
570 GOTO 490
580 REM
590 REM Draw the clock out line and dial
600 REM
610 R=160:HSM=R:VSM=R/RAT:CTH=DISPH/2:CTV=DISPV/2
620 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
630 CIRCLE (CTH,CTV),INT(HSM*1.2)
640 FOR T=0 TO 59
650 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
660 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
670 PSET(X,Y)
680 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
690 NEXT T
700 RETURN
710 REM
720 REM update clock
730 REM first erase the hands that move, then redraw all hands!
740 REM
750 IF NOT ((MID$(X$,4,2)="00" OR MID$(X$,4,2)="30") AND VAL(MID$(X$,7,2))<15) AND TICK THEN PLAY "MBMST255L64N1"
760 H=VAL(MID$(X$,1,2)):M=VAL(MID$(X$,4,2)):S=VAL(MID$(X$,7,2))
770 OLDH=VAL(MID$(OLDX$,1,2)):OLDM=VAL(MID$(OLDX$,4,2)):OLDS=VAL(MID$(OLDX$,7,2))
780 IF H<12 THEN AM=-1 ELSE AM=0:IF H>12 THEN H=H-12
790 IF OLDH>12 THEN  OLDH=OLDH-12
800 IF H<1 THEN H=H+12
810 IF OLDH<1 THEN OLDH=OLDH+12
820 IF NOT MODE THEN MID$(X$,1,2)=CHR$(48+INT(H/10))+CHR$(48+(H-INT(H/10)*10))
830 IF NOT MODE THEN MID$(OLDX$,1,2)=CHR$(48+INT(OLDH/10))+CHR$(48+(OLDH-INT(OLDH/10)*10))
840 REM dont forget 12/24 hour modes loop to zero not 1 O'clock
850 IF H=12 THEN H=0
860 IF OLDH=12 THEN OLDH=0
870 H=H+(INT(M/5)*5)/60
880 OLDH=OLDH+(INT(OLDM/5)*5)/60
890 M=M+(INT(S/10)*10)/60
900 OLDM=OLDM+(INT(OLDS/10)*10)/60
910 LOCATE 25,36:PRINT X$;:IF NOT MODE THEN IF AM THEN PRINT " AM   "; ELSE PRINT " PM   ";
920 IF MODE THEN PRINT "      ";
930 GOSUB 950:GOSUB 1170
940 RETURN
950 REM remove old hands
960 IF H=OLDH THEN 1040
970 REM calculate position of old hour hand and remove it only if it moved
980 HI=2*PI/12*(OLDH):X=CTH+INT(SIN(HI)*HSH+.5):Y=CTV-INT(COS(HI)*HSV+.5)
990 LINE (CTH,CTV)-(X,Y),0
1000 LINE (CTH+3,CTV+3)-(X,Y),0
1010 LINE (CTH-3,CTV-3)-(X,Y),0
1020 LINE (CTH-3,CTV+3)-(X,Y),0
1030 LINE (CTH+3,CTV-3)-(X,Y),0
1040 IF M=OLDM THEN 1120
1050 REM calculate position of old min hand and remove it
1060 MI=2*PI/60*OLDM:X=CTH+INT(SIN(MI)*MSH+.5):Y=CTV-INT(COS(MI)*MSV+.5)
1070 LINE (CTH,CTV)-(X,Y),0
1080 LINE (CTH+2,CTV+2)-(X,Y),0
1090 LINE (CTH-2,CTV-2)-(X,Y),0
1100 LINE (CTH-2,CTV+2)-(X,Y),0
1110 LINE (CTH+2,CTV-2)-(X,Y),0
1120 REM remove old sec hand
1130 SI=2*PI/60*OLDS:X=CTH+INT(SIN(SI)*SSH+.5):Y=CTV-INT(COS(SI)*SSV+.5)
1140 LINE (CTH,CTV)-(X,Y),0
1150 OLDH=H:OLDM=M:OLDS=S
1160 RETURN
1170 REM draw new hands
1180 REM draw second hand
1190 SI=2*PI/60*S:X=CTH+INT(SIN(SI)*SSH+.5):Y=CTV-INT(COS(SI)*SSV+.5)
1200 CIRCLE(CTH,CTV),(HSM/180)*5
1210 LINE (CTH,CTV)-(X,Y),7,,&H5555
1220 REM draw min hand
1230 MI=2*PI/60*M:X=CTH+INT(SIN(MI)*MSH+.5):Y=CTV-INT(COS(MI)*MSV+.5)
1240 LINE (CTH,CTV)-(X,Y),7
1250 LINE (CTH+2,CTV-2)-(X,Y),7
1260 LINE (CTH-2,CTV+2)-(X,Y),7
1270 LINE (CTH-2,CTV-2)-(X,Y),7
1280 LINE (CTH+2,CTV+2)-(X,Y),7
1290 REM draw hour hand
1300 HI=2*PI/12*H:X=CTH+INT(SIN(HI)*HSH+.5):Y=CTV-INT(COS(HI)*HSV+.5)
1310 IF TMP AND (LEFT$(ALARM$,5)=LEFT$(TIME$,5) AND ALARM) THEN BEEP
1320 IF TMP AND (MID$(X$,3,5)="30:00") THEN PLAY CHIME$
1330 IF TMP AND (MID$(X$,4,5)="00:00") THEN H=VAL(MID$(X$,1,2)):H=H+((H>12)*12):PLAY HOUR$(H)
1340 LINE (CTH,CTV)-(X,Y),7
1350 LINE (CTH+3,CTV-3)-(X,Y),7
1360 LINE (CTH-3,CTV+3)-(X,Y),7
1370 LINE (CTH-3,CTV-3)-(X,Y),7
1380 LINE (CTH+3,CTV+3)-(X,Y),7
1390 RETURN
1400 REM
1410 REM initialize small setup clock on left
1420 REM
1430 R=80:HSM=R:VSM=R/RAT:IF ATT THEN CTH=R*2:CTV=CTH
1440 IF NOT ATT THEN CTH=R*2:CTV=R
1450 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
1460 CIRCLE (CTH,CTV),INT(HSM*1.2)
1470 FOR T=0 TO 59 STEP 5
1480 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
1490 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
1500 PSET(X,Y)
1510 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
1520 NEXT T
1530 RETURN
1540 REM
1550 REM initialize small alarm dial on right
1560 REM
1570 R=80:HSM=R:VSM=R/RAT:IF ATT THEN CTH=640-(R*2):CTV=R*2
1580 IF NOT ATT THEN CTH=640-(R*2):CTV=R
1590 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
1600 CIRCLE (CTH,CTV),INT(HSM*1.2)
1610 FOR T=0 TO 59 STEP 5
1620 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
1630 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
1640 PSET(X,Y)
1650 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
1660 NEXT T
1670 RETURN
1680 REM
1690 REM enter setup screen
1700 REM
1710 CLS:LC=1:LOCATE 1,26:PRINT"WRITTEN BY  -- DAVID JOHNSON"
1720 GOSUB 2270
1730 LOCATE 4,15:PRINT"CURRENT TIME":LOCATE 4,56:PRINT"ALARM TIME";
1740 GOSUB 1430:X$=TIME$:OLDTIME$=X$
1750 GOSUB 1570:X$=ALARM$:OLDX$=OLDALM$:GOSUB 720:OLDALM$=ALARM$
1760 I$=INKEY$:IF I$=CHR$(27) THEN I$="":RETURN
1770 IF I$=CHR$(26) THEN GOSUB 2500:I$="":GOTO 1760
1780 LOCATE 19,16:PRINT TIME$
1790 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
1800 IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
1810 IF I$<>"" THEN GOSUB 1830
1820 GOTO 1760
1830 IF LEN(I$)>1 THEN I$=RIGHT$(I$,1):IF I$=CHR$(72) THEN I$="-" ELSE IF I$=CHR$(80) THEN I$=CHR$(13)
1840 IF I$<>CHR$(13) THEN 1880
1850 LC=LC+1:IF LC>6 THEN LC=1
1860 IF LC<1 THEN LC=6
1870 GOSUB 2270:RETURN
1880 IF I$="-" THEN LC=LC-1:GOTO 1860
1890 ON LC GOSUB 1900,1910,1920,2070,2080,2090,2210:GOSUB 2270:RETURN
1900 IF I$<>" " THEN RETURN ELSE TICK=0-ABS(TICK+1):RETURN
1910 IF I$<>" " THEN RETURN ELSE BELL=0-ABS(BELL+1):RETURN
1920 IF I$<"0" OR I$>"9" THEN RETURN
1930 NEWTIME$="":IF I$>="0" OR I$<="9" THEN 1950 ELSE LOCATE 19,16:PRINT"              ";
1940 I$=INKEY$
1950 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
1960 X$=TIME$:IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
1970 IF I$="" THEN 1940
1980 IF (I$>="0" AND I$<="9") OR I$=":" THEN NEWTIME$=NEWTIME$+I$:LOCATE 19,16:PRINT NEWTIME$;"             ";
1990 IF I$=CHR$(27) THEN I$="":LOCATE 23,1:PRINT SPACE$(79);:RETURN
2000 IF I$<>CHR$(13) THEN 1940
2010 IF NEWTIME$="" THEN RETURN
2020 IF LEN(NEWTIME$)=4 AND MID$(NEWTIME$,2,1)=":" THEN NEWTIME$="0"+NEWTIME$
2030 IF LEN(NEWTIME$)>5 THEN NEWTIME$=LEFT$(NEWTIME$,5)
2040 IF MID$(NEWTIME$,3,1)<>":" OR LEN(NEWTIME$)>5 THEN BEEP:LOCATE 23,1:PRINT"Invalid time format (##:##). Try again or hit return to leave time unchanged";:GOTO 1920
2050 TIME$=NEWTIME$
2060 IF LEFT$(NEWTIME$,2)<="12" THEN AM=-1 ELSE AM=0
2070 IF I$<>" " THEN RETURN ELSE MODE=0-ABS(MODE+1):RETURN
2080 IF I$<>" " THEN RETURN ELSE ALARM=0-ABS(ALARM+1):RETURN
2090 IF I$<"0" OR I$>"9" THEN RETURN
2100 NEWALARM$="":IF I$>="0" OR I$<="9" THEN 2120 ELSE LOCATE 18,58:PRINT "         ";
2110 I$=INKEY$
2120 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
2130 X$=TIME$:IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
2140 IF I$="" THEN 2110
2150 IF (I$>="0" AND I$<="9") OR I$=":" THEN NEWALARM$=NEWALARM$+I$:LOCATE 18,58:PRINT NEWALARM$;"        ";
2160 IF I$=CHR$(27) THEN I$="":LOCATE 23,1:PRINT SPACE$(79);:RETURN
2170 IF I$<>CHR$(13) THEN 2110
2180 IF NEWALARM$="" THEN RETURN
2190 IF LEN(NEWALARM$)=4 AND MID$(NEWALARM$,2,1)=":" THEN NEWALARM$="0"+NEWALARM$
2200 IF LEN(NEWALARM$)>5 THEN NEWALARM$=LEFT$(NEWALARM$,5)
2210 IF MID$(NEWALARM$,3,1)<>":" THEN BEEP:LOCATE 23,1:PRINT"Invalid time format (##:##). Try again or hit return to leave time unchanged";:GOTO 2090
2220 TMP=0:X$=NEWALARM$+":00":OLDX$=OLDALM$+":00":CTH=640-(R*2):CTV=R*2:IF NOT ATT THEN CTV=R
2230 GOSUB 720:ALARM$=NEWALARM$:OLDALM$=ALARM$:TMP=-1
2240 RETURN
2250 RETURN
2260 RETURN
2270 REM display settings
2280 REM for setup screens
2290 LOCATE 23,1:PRINT SPACE$(79);
2300 LOCATE 22,20:PRINT "PRESS F1 TO SAVE THE NEW CONFIGURATION";
2310 LOCATE 21,20:PRINT "PRESS SPACE BAR TO TOGGLE ON/OFF THEN";
2320 LOCATE 17,8:PRINT"  TICK= ";:IF TICK THEN PRINT "ON " ELSE PRINT "OFF"
2330 LOCATE 18,8:PRINT"  BELL= ";:IF BELL THEN PRINT "ON " ELSE PRINT "OFF"
2340 LOCATE 19,8:PRINT"  TIME= ";X$;:IF NOT MODE THEN IF AM THEN PRINT" AM " ELSE PRINT" PM "
2350 IF MODE THEN PRINT"    "
2360 LOCATE 20,8:PRINT"  MODE= ";:IF MODE THEN PRINT "24 " ELSE PRINT "12 "
2370 LOCATE 17,48:PRINT"  ALARM = ";:IF ALARM THEN PRINT "ON " ELSE PRINT "OFF"
2380 LOCATE 18,48:PRINT"  TIME  = ";ALARM$;:IF NOT MODE THEN IF LEFT$(ALARM$,2)<"12" THEN PRINT" AM " ELSE PRINT" PM "
2390 IF MODE THEN PRINT"    "
2400 IF LC<=4 THEN LOCATE 16+LC,8:PRINT CHR$(15);
2410 IF LC>4 THEN LOCATE 16+LC-4,48:PRINT CHR$(15);
2420 RETURN
2430 ON ERROR GOTO 2490
2440 REM look for default data file
2450 OPEN "data.dat" FOR INPUT AS #1
2460 INPUT #1,TICK:INPUT #1,BELL:INPUT #1,MODE:INPUT #1,ALARM:INPUT #1,ALARM$:INPUT #1,TMP
2470 CLOSE #1:ON ERROR GOTO 0
2480 RETURN
2490 RESUME 2470:REM ERROR -- no default file use standard defaults
2500 ON ERROR GOTO 2570
2510 REM save default settings
2520 OPEN "data.dat" FOR OUTPUT AS #1
2530 PRINT #1,TICK:PRINT #1,BELL:PRINT #1,MODE:PRINT #1,ALARM:PRINT #1,ALARM$:PRINT #1,TMP
2540 LOCATE 23,25:PRINT"CURRENT CONFIGURATION SAVED";
2550 CLOSE #1:ON ERROR GOTO 0
2560 RETURN
2570 RESUME 2550
2580 SCREEN 0:CLS
2590 LOCATE 1,10:PRINT "PROGRAM WRITTEN BY:"
2600 LOCATE 1,40:PRINT "DAVID JOHNSON     "
2610 LOCATE 2,40:PRINT "551 Willow st.    "
2620 LOCATE 3,40:PRINT "S. Hempstead, N.Y."
2630 LOCATE 4,40:PRINT "             11550"
2640 LOCATE  7,20:PRINT "***************************************"
2650 LOCATE 11,20:PRINT "***************************************"
2660 LOCATE  8,20:PRINT "* If you have found this program to   *"
2670 LOCATE  9,20:PRINT "* be of any value, your controbution  *"
2680 LOCATE 10,20:PRINT "* ($5 suggested) will be appreciated. *"
2700 LOCATE 16,18:PRINT "     You are encouraged to copy and share"
2710 LOCATE 17,18:PRINT "this program with others, on the conditions"
2720 LOCATE 18,18:PRINT "that the program is not distributed in"
2730 LOCATE 19,18:PRINT "modified form, that no fee or consideration"
2740 LOCATE 20,18:PRINT "is charged, and this notice is not bypassed."
2750 LOCATE 24,1:PRINT"Hit any ket to exit,";
2760 LOCATE 25,1:PRINT"or hit <esc> to return to clock";
2770 X$=INKEY$:IF X$="" THEN 2770
2780 IF X$=CHR$(27) THEN RETURN
2790 SCREEN 2,0:SCREEN 0
2800 END
2810 REM data for hour chimes
2820 DATA "MBT80MNO2L4ecd<L2g>L4cdeL2cP2T100"